perm filename MLIST.F4[CMS,LCS]1 blob
sn#081715 filedate 1974-01-17 generic text, type T, neo UTF8
00100 COMMON JA
00200 DIMENSION JA(10,200),JB(6,200),JC(6,200),JD(6,200),NA(10)
00300 102 U=0
00400 8 K=0
00500 NB=0
00600 TYPE 6
00700 6 FORMAT(' NEW FILE OR OLD?'/)
00800 ACCEPT 10,M
00900 IF(M.EQ.' '.AND.U.EQ.1)GO TO 43
01000 TYPE 22
01100 22 FORMAT(' TYPE A FILE NAME UP TO 5 LETTERS LONG.'/)
01200 ACCEPT 23,F
01300 23 FORMAT(A5)
01400 IF(M.EQ.'O')GO TO 43
01500 10 FORMAT(A1)
01600 15 TYPE 7
01700 7 FORMAT(' TYPE:NAME ON LINE 1,ADDRESS ON LINES 2 AND 3,'/
01800 1 ' AND UP TO 6 ONE LETTER LIST NAMES ON LINE 4.'/)
01900 NB=1
02000 2 K=K+1
02100 TYPE 3
02200 3 FORMAT(' IF FINISHED TYPE <CR>.'/)
02300 ACCEPT 9,(JA(I,K),I=1,10)
02400 9 FORMAT(7A1,3A5)
02500 IF(JA(1,K).EQ.' ')GO TO 33
02600 ACCEPT 11,(JB(I,K),I=1,6)
02700 11 FORMAT(2A1,4A5)
02800 ACCEPT 11,(JC(I,K),I=1,6)
02900 ACCEPT 20,(JD(I,K),I=1,6)
03000 20 FORMAT(6A1)
03100 GO TO 2
03200 43 IF(LOOKD(F))GO TO 44
03300 TYPE 58,F
03400 58 FORMAT(1XA5,' FILE NOT FOUND.'/)
03500 GO TO 102
03600 44 REWIND 1
03700 CALL IFILE(1,F)
03800 READ(1)K,((JB(I,L),I=1,6),L=1,K)
03900 READ(1)((JA(I,L),I=1,10),L=1,K)
04000 READ(1)((JC(I,L),I=1,6),L=1,K)
04100 READ(1)((JD(I,L),I=1,6),L=1,K),K
04200 134 TYPE 66
04300 66 FORMAT(' TYPE ADD,CHANGE,DELEAT OR <CR> FOR PRINTOUT.'/)
04400 ACCEPT 10,P
04500 IF(P.EQ.'A')GO TO 15
04600 IF(P.NE.'C'.AND.P.NE.'D')GO TO 146
04700 110 TYPE 111
04800 111 FORMAT(' TYPE NAME OR IF FINISHED TYPE <CR>.'/)
04900 ACCEPT 9,(NA(I),I=1,10)
05000 IF(NA(1).EQ.' ')GO TO 134
05100 DO 114 N=1,K
05200 J=0
05300 DO 114 I=1,10
05400 IF(JA(I,N).EQ.NA(I))J=J+1
05500 IF(J.EQ.10)GO TO 148
05600 114 CONTINUE
05700 TYPE 116
05800 116 FORMAT(' NAME NOT FOUND.'/)
05900 GO TO 134
06000 148 IF(P.EQ.'D')GO TO 149
06100 NB=1
06200 TYPE 117
06300 117 FORMAT(' TYPE NEW NAME OR <CR> FOR NO CHANGE.'/)
06400 ACCEPT 9,(NA(I),I=1,10)
06500 IF(NA(1).EQ.' ')GO TO 119
06600 DO 131 I=1,10
06700 131 JA(I,N)=NA(I)
06800 119 TYPE 136,(JB(I,N),I=1,6)
06900 TYPE 121
07000 121 FORMAT(' TYPE NEW ADDRESS LINE OR <CR> FOR NO CHANGE.'/)
07100 ACCEPT 11,(NA(I),I=1,6)
07200 136 FORMAT(1X2A1,4A5)
07300 IF(NA(1).EQ.' ')GO TO 122
07400 DO 123 I=1,6
07500 123 JB(I,N)=NA(I)
07600 122 TYPE 136,(JC(I,N),I=1,6)
07700 TYPE 121
07800 ACCEPT 11,(NA(I),I=1,6)
07900 IF(NA(1).EQ.' ')GO TO 124
08000 DO 125 I=1,6
08100 125 JC(I,N)=NA(I)
08200 124 TYPE 137,(JD(I,N),I=1,6)
08300 137 FORMAT(1X6A1)
08400 TYPE 127
08500 127 FORMAT(' TYPE NEW LIST NAMES OR <CR> FOR NO CHANGE.'/)
08600 ACCEPT 20,(NA(I),I=1,6)
08700 IF(NA(1).EQ.' ')GO TO 134
08800 DO 129 I=1,6
08900 129 JD(I,N)=NA(I)
09000 GO TO 134
09100 33 K=K-1
09200 P=' '
09300 146 IF(NB.EQ.0)GO TO 132
09400 104 DO 5 N=1,K-1
09500 IF(LN(N).LE.LN(N+1))GO TO 5
09600 DO 27 I=1,10
09700 27 JA(I,K+1)=JA(I,N)
09800 DO 133 I=1,6
09900 JB(I,K+1)=JB(I,N)
10000 JC(I,K+1)=JC(I,N)
10100 133 JD(I,K+1)=JD(I,N)
10200 149 DO 82 J=N,K
10300 DO 26 I=1,10
10400 26 JA(I,J)=JA(I,J+1)
10500 DO 47 I=1,6
10600 JB(I,J)=JB(I,J+1)
10700 JC(I,J)=JC(I,J+1)
10800 47 JD(I,J)=JD(I,J+1)
10900 82 CONTINUE
11000 IF(P.NE.'D')GO TO 104
11100 K=K-1
11200 NB=NB+NB
11300 GO TO 134
11400 5 CONTINUE
11500 132 REWIND 1
11600 CALL OFILE(1,F)
11700 WRITE(1)K,((JB(I,L),I=1,6),L=1,K),K
11800 WRITE(1)((JA(I,L),I=1,10),L=1,K),K
11900 WRITE(1)((JC(I,L),I=1,6),L=1,K),K
12000 WRITE(1)((JD(I,L),I=1,6),L=1,K),K,K
12100 END FILE 1
12200 60 TYPE 77
12300 77 FORMAT(' TYPE LIST NAME OR <CR> FOR ALL LISTS.'/)
12400 ACCEPT 10,JE
12500 Y=' '
12600 IF(JE.EQ.' ')GO TO 53
12700 N=1
12800 DO 99 L=1,K
12900 DO 97 I=1,6
13000 IF(JD(I,L).EQ.JE)GO TO 98
13100 97 CONTINUE
13200 GO TO 99
13300 98 DO 51 M=1,10
13400 51 JA(M,N)=JA(M,L)
13500 DO 100 M=1,6
13600 JB(M,N)=JB(M,L)
13700 JC(M,N)=JC(M,L)
13800 100 JD(M,N)=JD(M,L)
13900 N=N+1
14000 99 CONTINUE
14100 K=N
14200 53 Y='Y'
14300 TYPE 13
14400 13 FORMAT(' TTY OR LINE PRINTER?'/)
14500 ACCEPT 10,T
14600 IF(T.NE.'L')GO TO 103
14700 TYPE 88
14800 88 FORMAT(' PRINT WITH LIST NAMES?'/)
14900 ACCEPT 10,Y
15000 103 LIST=5
15100 IF(T.EQ.'L')LIST=3
15200 WRITE(LIST,91)F,JE
15300 91 FORMAT(//28XA5,' FILE',4XA1,' LIST')
15400 ID=2
15500 DO 45 J=1,K,3
15600 IF(K-(J-1).LT.3)ID=MOD(K,3)-1
15700 WRITE(LIST,19)((JA(I,L),I=1,10),L=J,J+ID)
15800 19 FORMAT(//3(2X7A1,3A5))
15900 WRITE(LIST,46)((JB(I,L),I=1,6),L=J,J+ID)
16000 46 FORMAT(3(2X2A1,4A5))
16100 WRITE(LIST,46)((JC(I,L),I=1,6),L=J,J+ID)
16200 IF(Y.NE.'Y')GO TO 45
16300 WRITE(LIST,48)((JD(I,L),I=1,6),L=J,J+ID)
16400 48 FORMAT(/4X5A1,2(19X5A1))
16500 45 CONTINUE
16600 IF(T.EQ.'L')CALL EXIT
16700 U=1
16800 GO TO 8
16900 END
17000
17100 FUNCTION LN(M)
17200 MX=100000000
17300 LN=0
17400 DO 1 K=1,5
17500 LN=LN+NU(K,M,MX)
17600 1 MX=MX/100
17700 RETURN
17800 END
17900
18000 FUNCTION NU(K,M,MX)
18100 COMMON JA(10,200)
18200 NU=(1-('A'-JA(K,M))/536870912)*MX
18300 RETURN
18400 END